COMMENT ⊗   VALID 00017 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	Declarations
C00010 00003	I/O: ttin,lookupfail,enterfail,inscan,resp,ynresp,cresp,textinfail,invout
C00017 00004	Procedure rdaddr, buildtree, and addfilin for address file input
C00023 00005	Procedures wraddr, untree, addfilout for address file output
C00026 00006	binary search tree maintenance routines: search,insert,delete
C00030 00007	Procedures to access the address file: unpack,display,find
C00033 00008	Sub-procedures for update actions: zipcheck,gethash
C00036 00009	procedures for update actions: look,ins,mfy,del,update
C00041 00010	The procedure which records orders received
C00044 00011	Procedures for making labels: lab,emitlab,endlab
C00047 00012	The MAIL procedure and its subprocedures abst,invo,inv,status,scanorders
C00060 00013	The `receive' procedure, which handles virtual money
C00063 00014	The `send' procedure, for isolated orders
C00073 00015	The president (chief executive)
C00075 00016	The program starts here (sets string constants, including HELPs)
C00083 00017	Set breaks, open channels, call main procedure, end gracefully
C00085 ENDMK
C⊗;
comment Declarations;
begin comment This is the CS report system coded by D. Knuth, October 1976;

EXTERNAL PROCEDURE BAIL;

require 200 system_pdl;
require 30000 string_space;

require "⊂⊃" delimiters;
define # = ⊂;comment⊃;
define crlf = ⊂('15&'12)⊃;
define icr = ⊂'15⊃;
define ialt = ⊂'175⊃;
define iff = ⊂'14⊃;
define asize = ⊂1600⊃ # maximum number of addresses in the mailing list;
define logasize = ⊂11⊃ # must be equal to 1 + floor(lg asize);
define bsize = ⊂1000⊃ # maxmimum number of old reports in backorder file;

define cvc(i) = ⊂(if i<10 then "0"+i else ("A"-10)+i)⊃ # encodes
			small integer as a single character;

define btt = ⊂1⊃ # breaktable for ttin;
define bfflf = ⊂2⊃ # break on formfeed (end page) or linefeed (end line);
define blf = ⊂3⊃ # break on linefeed;
define babs = ⊂4⊃ # break on |;
define bast = ⊂5⊃ # break on *;
define bff = ⊂6⊃ # break on formfeed;
define bvar = ⊂7⊃ # variable break table, set dynamically;

boolean eof # end of file indicator;
integer brchar # break character;
integer flag # input-output flag;
integer ichan # channel for character input;
integer ochan # channel for character output;
integer lchan # channel for mailing label output;

integer c,d,i,j,k,m,p,q,t # miscellaneous temporary integers, pointers, etc.;
string s,st,stt,str # miscellaneous temporary strings;

string typein # input returned by ttin, ends with cr;
integer scale # scale factor returned by inscan;
integer nl # number of lines returned by unpack;
string array lne[0:6] # individual lines of an address;

integer array llink,rlink,key,balance[0:asize] # binary search tree structure;
	comment the address file is organized as a binary tree.
	key[p] is the hashcode, in binary form, of the addressee whose
	serial number is p. balance[p] is the number of pennies he owes.
	Unused positions of the table are doubly-linked into an AVAIL list
	whose head is at position 0. Such entries have key=0;
string array nmline,lines[0:asize] # nmline[p] is line 1 of an address,
	ending with crlf. lines[p] contains the rest of the address information,
	as follows: Let s=lines[p], then
		s[1 to 1] is the mailing category ("C","F","A","N",or "M")
		s[2 to 6] is the zip code or country
		s[7 to 18] is the activity code for last 12 mailings
			(0,1,...,9,A,B,... for 0, 1, ..., 9, 10, 11, ...
			orders, or Z if there were back-orders)
		s[19 to ∞] is lines 2,3, etc. of the address, including
			carriage returns and line feeds but not US zip code;
integer troot # the root of the main binary search tree;

integer recd # total money (in cents) received in today's transactions;
integer fixd # total accounting adjustments in today's transactions;
integer chgd # total money charged to accounts in today's transactions;
integer calrecd # total amount of receipts from California residents;

boolean mailed # has MAIL already set up output to be spooled?;
boolean sended # has SEND already set up output to be spooled?;
boolean afchanged # should ADDFIL.DSK be written out after processing?;
 
string date # today's date in form dd MON 19yy;
string mon # month whose orders are being processed (3-letter abbr);

string lf,ff,tab,cshelp,findhelp1,findhelp2,codehelp,updhelp,ordhelp,yesnohelp,
	blanks,mailhelp,acthelp,sendhelp,rhelp # constant strings, see page 16;

string array canned[0:18] # textx used to write invoices;

preload_with "JAN","FEB","MAR","APR","MAY","JUN",
	"JUL","AUG","SEP","OCT","NOV","DEC"; string array months[1:12];
preload_with "Y","N"; string array yesnoopts[1:2];
preload_with ""; string array nullopt[1:1];
preload_with "UPD","ORD","REC","MAI","SEN"; string array csopts[1:5];
preload_with "C","F","N","M","A"; string array codeopts[1:5];
preload_with "INS","DEL","MOD","LOOK"; string array updopts[1:4];
preload_with "AVER","CHES";string array labelopts[1:2];
preload_with "ABS", "REP"; string array mailopts[1:2];
comment I/O: ttin,lookupfail,enterfail,inscan,resp,ynresp,cresp,textinfail,invout;

procedure ttin;
begin comment sets typein to the line typed in and echoes it also on
	the PRINT file, then gets rid of leading blanks;
integer i;
typein←inchwl&icr; comment alternate for  ttyin(btt,brchar);
setprint(null,"I"); print(typein,lf); setprint(null,"C");
while typein = " " do i←lop(typein);
end;

boolean procedure lookupfail(integer chan; string file);
begin close(chan); lookup(chan,file,flag);
if flag then print(crlf,"Whoa, I can't find ",file,", so I'm stuck.",crlf);
return(flag);
end;

boolean procedure enterfail(integer chan; string file);
begin close(chan); enter(chan,file,flag);
if flag then print(crlf,"Whoa, system error trying to enter ",file,
	", so I'm stuck.",crlf);
return(flag);
end;

integer procedure inscan;
begin comment returns integer contents of typein, ignoring nondigits;
comment sets brchar to last nondigit, scale to no. of digits after ".";
integer t,d; 
t←scale←0; brchar←0;
while typein≠icr do
	begin d←lop(typein);
	if d≥"0" and d≤"9" then
		begin t←10*t+d-"0";
		if brchar="." then scale←scale+1;
		end
	else brchar←d;
	end;
return(t);
end;

integer procedure resp(string q; reference string h; string array opts);
begin comment q is the question, h is the HELP string, and opts lists
	the initial characters of allowable responses;
comment the output is 0 if the response was <cr>, otherwise it is the
	index of the option typed;
integer i;
while true do
	begin print(q); ttin;
	if typein=icr then return(0);
	if typein≠"?" then
		begin if equ(typein[1 to 4],"HELP") then
			begin print(crlf,h,crlf,crlf);continue;
			end;
		for i←1 step 1 until arrinfo(opts,2) do
			if equ(typein[1 to length(opts[i])],opts[i])
			then return(i);
		end;
	print("?The responses I can understand at this point are:",crlf);
	for i←1 step 1 until arrinfo(opts,2) do
		print(opts[i],"...,");
	print(crlf,"or <cr> (to get out of this loop),",crlf);
	print("or HELP<cr> (for more information).",crlf);
	end;
end;

integer procedure ynresp(string q);
return(resp(q&" (Y or N) ",yesnohelp,yesnoopts));

integer procedure cresp(string q);
begin comment q asks for a response in dollars and cents;
comment this procedure returns the amount in cents, or -1 if response is just <cr>;
comment also brchar is set to the last nondigit typed;
integer c;
while true do
	begin print(q,"$"); ttin;
	if typein=icr then return(-1);
	c←inscan;
	if scale=2 then return(c);
	print("?I wanted you to type a dollars-and-cents number like 3.14<cr>",
	"----",crlf,"Please try again, or just type <cr> to get out of this.",
	crlf);
	end;
end;

boolean procedure textinfail;
begin comment the canned text for invoices is read into memory;
if lookupfail(ichan,"FORM.DAT") then return(true);
do st←input(ichan,bfflf) until equ(st[1 to 7],"INVOICE");
for i←0 step 1 until 18 do canned[i]←input(ichan,bast);
comment for the desired form of FORM.DAT, see the example in the
	user manual and/or the procedure invout below;
return(false);
end;

procedure invout(reference string send,sorry,name,addrlabel;
	integer oldbal,charges; boolean Calif);
begin comment outputs an invoice to ochan;
integer newbal; string str;
out(ochan,canned[0]&date&canned[1]&name&canned[2]);
if sorry≠0 then out(ochan,canned[4]&crlf&sorry&crlf&canned[5]&crlf);
if send≠0 then 
	begin out(ochan,canned[3]&crlf&send&crlf);
	if Calif and charges>0 then out(ochan,canned[15]&crlf);
	end;
newbal←oldbal+charges; str←cvf(abs(newbal)/100);
if charges>0 then
	begin if oldbal=0 then out(ochan,canned[8]&str&canned[9])
	else if newbal>0 then out(ochan,canned[10]&str&canned[11])
	else if newbal<0 then out(ochan,canned[12]&str&canned[13])
	else out(ochan,canned[14])
	end
else if oldbal>0 then out(ochan,canned[6]&str&canned[7]);
if newbal>0 then out(ochan,crlf&canned[16]&str&canned[17]&addrlabel
	&canned[18])
else out(ochan,crlf&lf&lf&addrlabel&ff);
end;
comment Procedure rdaddr, buildtree, and addfilin for address file input;

integer prevk # previous key read by rdaddr;

integer procedure rdaddr;
begin comment reads and stores the next address from ADDFIL.DSK,
	returning the serial number;
comment returns 0 if end of file sensed;
comment during this procedure, st represents the file line most recently
	read but not yet digested;
comment The DDDFIL.DSK contains up to ten entries per page, preceded by a
	header line giving all hashcodes for that page. Each entry begins
	with a line in the format
		*CZZZZZ|AAAAAAAAAAAA#HHHHHSSSSS$BALcrlf
	where C=category, ZZZZZ=zipcode, AAAAAAAAAAAA=activity codes,
	HHHHH=hashcode, SSSSS=serial number, BAL=dollar balance due
	(preceded by - if negative). Then comes 2 to 5 lines of the
	address, each of which should be at most 34 characters wide
	in most cases;
string ent,name,addr; integer loc,k; label start;
key[0]←1;nmline[0]←"Listhead"&crlf;
start:
comment if the file was in E editor format, pass over the index page;
while st ≠ "*" do
	if eof then return(0) else st←input(ichan,bfflf);
ent←st;name←input(ichan,bfflf);
addr←input(ichan,bfflf);
st←addr[1 to 1];
comment now ent,name,addr are the first three address lines;
while st ≠ "*" and st ≠ "#" do
	begin if length(st)>2 then addr←addr&st;
	if eof then done;
	st←input(ichan,bfflf);
	end;
loc←cvd(ent[27 to 31]);
if loc>asize then
	begin print(crlf,"ADDFIL.DSK error, serial number too big...
	the following name has been deleted from the file:",crlf,name,
	"since it had a serial number of ",loc,".",crlf,
	"...The rest of the deleted file entry was:",crlf,ent,addr);
	go to start;
	end;
if key[loc]≠0 then
	begin print(crlf,"ADDFIL.DSK error, two people with same serial",
	" number...
	the following name has been deleted from the file:",crlf,name,
	"since it had the same serial number as:",crlf,nmline[loc],
	"...The rest of the deleted file entry was:",crlf,ent,addr); 
	go to start;
	end;
k←cvasc(ent[22 to 26]);
if k ≤ prevk then
	begin print(crlf,"ADDFIL.DSK error, hash codes not increasing...
	the following name has been deleted from the file:",crlf,name,
	"since its hash code was not greater than the preceding one.",crlf,
	"...The rest of the deleted file entry was:",crlf,ent,addr);
	go to start;
	end;
key[loc]←k; prevk←k;
rlink[llink[loc]]←rlink[loc];llink[rlink[loc]]←llink[loc] # remove from AVAIL;
nmline[loc]←name;lines[loc]←ent[2 to 7]&ent[9 to 20]&addr;
typein←ent[33 to ∞]; balance[loc]←inscan;
if ent[33 to 33]="-" then balance[loc]←-balance[loc];
return(loc);
end;

recursive integer procedure buildtree(integer m);
begin comment builds a somewhat balanced binary search tree of up to
		2↑m-1 nodes, returning a pointer to the root;
integer root,subtree;
if m=0 then return(0) else
	begin subtree←buildtree(m-1);
	root←rdaddr;
	if root=0 then return(subtree) else
		begin llink[root]←subtree;
		rlink[root]←buildtree(m-1);
		return(root);
		end;
	end;
end;

procedure addfilin;
begin comment inputs the address file, assuming that it is on ichan;
for i←1 step 1 until asize-1 do
	begin key[i]←0; llink[i]←i-1; rlink[i]←i+1;
	end;
key[0]←0;llink[0]←asize;rlink[0]←1;
key[asize]←0;llink[asize]←asize-1;rlink[asize]←0;
st←""; prevk←'400000000000;
troot←buildtree(logasize);
end;
comment Procedures wraddr, untree, addfilout for address file output;

integer totbal # total balance from all accounts in the file;
integer kf,kn,km,ka # total number of entries of various categories;

procedure wraddr(integer p);
begin comment appends the address for serial number p to current output page,
	and outputs if the page is full);
comment also gathers statistics about the file;
string s,t;
t←lines[p];
out(ochan,"*"); out(ochan,t[1 to 6]); out(ochan,"|"); out(ochan,t[7 to 18]);
out(ochan,"#"); out(ochan,cvstr(key[p]));
setformat(5,2); out(ochan,cvs(p)); setformat(0,2);
out(ochan,"$"); out(ochan,cvf(balance[p]/100)); out(ochan,crlf);
out(ochan,nmline[p]); out(ochan,t[19 to ∞]);
totbal←totbal+balance[p];
k←k+1;
if t≠"C" then
	begin if t="F" then kf←kf+1
	else if t="A" then ka←ka+1
	else if t="N" then kn←kn+1
	else if t="M" then km←km+1;
	end;
if k mod 20 = 0 then out(ochan,ff);
end;

recursive procedure untree(integer p);
begin comment outputs the binary search tree rooted at p in order by key;
if p≠0 then
	begin untree(llink[p]);
	wraddr(p);
	untree(rlink[p]);
	end;
end;

procedure addfilout;
begin comment outputs the entire address file to ochan;
k←kf←ka←kn←km←totbal←0;
untree(troot);
print(crlf,"The address file now contains a total of ",k," entries,
including the following special categories:
F = ",kf," A = ",ka," N = ",kn," M = ",km,crlf,
"and the total balance outstanding is $",cvf(totbal/100),".",crlf);
if asize-k<50 then print("I am currently programmed to handle up to ",
	asize," entries maximum.",crlf);
end;
comment binary search tree maintenance routines: search,insert,delete;

integer lp # last position unsuccessfully probed in search routine;

integer procedure search(integer k);
begin comment returns serial number of addressee having key k,
	or 0 if not in the table;
integer p;
p←troot; lp←0; key[0]←k;
while k≠key[p] do
	begin lp←p;
	if k<key[p] then p←llink[p] else p←rlink[p];
	end;
return(p);
end;

integer procedure insert(reference string name,ent; string hash; integer bal);
begin comment inserts new address file entry into an available place
	and returns the value of this place (i.e. the serial number);
integer p,k;
k←cvasc(hash);
p←rlink[0] # get available location;
if p=0 then
	begin print("The mailing list is now completely full, so I can't ",
	"insert the entry for the",crlf," following name: ",name,
	"To increase the table size one may simply recompile CSREPT",crlf,
	"with asize and logasize defined larger. 
	(But do we really want such a big mailing list?)",crlf);
	return(0);
	end;
rlink[0]←rlink[p]; llink[rlink[p]]←0 # remove from AVAIL list;
nmline[p]←name; lines[p]←ent; key[p]←k; balance[p]←bal;
llink[p]←rlink[p]←0;
fixd←fixd-bal;
if k<key[lp] then llink[lp]←p else rlink[lp]←p;
return(p);
end;

procedure delete(integer k);
begin comment deletes entry with key k from its place in the address file,
	using the standard algorithm;
integer p,q,r;
p←search(k);
if p=0 then
	begin print("Hmm... Something went wrong, I just attempted to ",
	"delete a nonexistent key.",crlf); return;
	end;
comment new delete p from its subtree, yielding a subtree with root q;
if llink[p]=0 then q←rlink[p]
else if rlink[p]=0 then q←llink[p]
else	begin q←rlink[p];
	if llink[q]=0 then llink[q]←llink[p]
	else	begin do q←llink[r←q] until llink[q]=0;
		llink[r]←rlink[q]; llink[q]←llink[p]; rlink[q]←rlink[p];
		end;
	end;
comment now adjust the upper part of the tree and the AVAIL list;
if lp=0 then troot←q
else if k<key[lp] then llink[lp]←q else rlink[lp]←q;
q←rlink[0]; rlink[p]←q; llink[q]←p; llink[p]←0; rlink[0]←p;
comment the next insert will go into location p again (this property
	is used in the update "mfy" routine);
key[p]←0; nmline[p]←lines[p]←"";
fixd←fixd+balance[p]; balance[p]←0;
end;
comment Procedures to access the address file: unpack,display,find;

procedure unpack(integer p);
begin comment takes entry from address file position p and stores it
	in lne[0], lne[1], ..., lne[nl];
string ent,zip;
lne[1]←nmline[p];
lne[0]←lines[p][1 to 18];
ent←lines[p][19 to ∞];
for j←2 step 1 until 6 do
	begin lne[j]←scan(ent,blf,brchar);
	if ent=0 then
		begin nl←j; done;
		end;
	end;
zip←lne[0][2 to 6];
if zip≤"9" then lne[nl]←lne[nl][1 to ∞-2]&"  "&zip&crlf;
end;

procedure display(integer p);
begin comment types an address entry;
string ent,s;
unpack(p);
for j←1 step 1 until nl do
	print("LINE ",j,": ",lne[j]);
print("hashcode=#",cvstr(key[p]),",   category=",lne[0][1 to 1],
	",   serial=",p,
	if equ(lne[0][2 to 6],"IDMAI") then ",  IDMAIL," else ",",
	crlf,"ordering history=",lne[0][7 to 18],
	",   current balance=$",cvf(balance[p]/100),crlf);
end;

integer procedure find(string s);
begin comment interactive specification of a table entry,
	where s is part of the prompting message;
integer k,p,c,d;
while true do
	begin if resp("Type hashcode "&s&": #",findhelp1,nullopt) = 0
	then return(0);
	if (p←search(cvasc(typein[1 to 5])))≠0 then
	case ynresp("Is the name "&nmline[p][1 to ∞-2]&"?") of
		begin return(0); return(p); ;
		end
	else	begin if resp("Sorry, that hashcode isn't in the file."
		&" What is the name? ",findhelp2,nullopt)=0 then return(0);
		typein←typein[1 to ∞-1]; d←length(typein);
		c←typein; setbreak(bvar,c,null,"IR");
		print("Here are all the entries matching that name:",crlf);
		for i ← 1 step 1 until asize do if key[i]≠0 then
			begin stt←nmline[i];
			while true do
				begin scan(stt,bvar,brchar);
				if brchar=0 then done;
				if equ(stt[1 to d],typein) then
					begin print("#",cvstr(key[i]),
					": ",nmline[i]); done;
					end else k←lop(stt);
				end;
			end;
		end
	end
end;

comment Sub-procedures for update actions: zipcheck,gethash;

string zip,hash # returned by zipcheck and gethash;

boolean procedure zipcheck (boolean newzip);
begin comment before writing an address into the file, we need to check its
	zip code for validity: the first three characters of the hash and the
	zip should agree;
comment this procedure set zip to the desired zip code and sets typeing to
	the classification category, or returns false if the user wishes
	to flush the address;
integer i,k;
stt←lne[nl][1 to ∞-2]&"    "; k←length(stt)-5;
while k>0 and stt[k to k]=" " do k←k-1;
comment find the five characters after the rightmost blank;
while k>0 and stt[k to k]≠" " do k←k-1;
zip←stt[k+1 to k+5];
if newzip then
	print("I deduce that the ZIP code or country is ",zip,";
	if not, please reject this and try again.",crlf);
case resp("Type the classification (C,F,N,M, or A), or type <cr> to reject "
	&"this entry: ",codehelp,codeopts) of
	begin return(false);
	if zip≤"9" or equ(zip,"IDMAI") then lne[nl]←stt[1 to k]&crlf # C;
	if zip≤"9" or equ(zip,"IDMAI") then lne[nl]←stt[1 to k]&crlf # F;
	zip←"ONRXX" # N;
	zip←"DARPA" # M;
	zip←"AUTOM" # A;
	end;
return(true);
end;

procedure gethash;
begin comment sets hash to a hashcode not already in the table,
	beginning with the first three characters of zip;
integer j,k,c,d;
k←length(lne[1]); j←k div 3; k←2*j;
do	begin c←lne[1][j to j]; j←j-1;
	end until (c≥"A" and c≤"Z") or j=0;
if c<"A" or c>"Z" then c←"X";
do	begin d←lne[1][k to k]; k←k-1;
	end until (d≥"A" and d≤"Z") or k=0;
if k=0 then d←"J";
while true do
	begin hash←zip[1 to 3]&c&d; k←cvasc(hash);
	if search(k)=0 then done;
	if d≠"Z" then d←d+1
	else	begin d←"A";
		if c≠"Z" then c←c+1 else c←"A";
		end;
	end # will loop forever if 676 people with same zip[1 to 3];
end;
comment procedures for update actions: look,ins,mfy,del,update;

procedure look;
if(p←find("of entry to be displayed"))=0 then return
else display(p);

procedure shorten(integer d);
print("That line was ",d," character", if d=1 then "" else "s",
" too long for our mailing labels.
Please shorten it.",crlf);

procedure ins;
begin comment interactive insertion of new address;
integer i,c,p; string ent;
print("Type the new address, two to five lines long:",crlf);
nl←0; for i←1 step 1 until 5 do
	begin label prompt;
prompt:	print("Line ",i,": "); ttin;
	if typein=icr then done;
	if length(typein)>35 then
		begin shorten(length(typein)-35);
		go to prompt;
		end;
	lne[i]←typein&lf; nl←i;
	end;
if nl=0 then return;
if nl=1 then
	begin print("You need another line; try again.",crlf); return;
	end;
if not zipcheck(true) then return;
c←lop(typein) # C, F, N, M, or A;
gethash;
ent←c&zip&"NNNNNNNNNNN0";
for i←2 step 1 until nl do ent←ent&lne[i];
if(p←insert(lne[1],ent,hash,0))=0 then return;
afchanged←true;
print("OK, I've inserted it; hash code is #",hash,", serial number is ",p,crlf);
end;

procedure mfy;
begin comment interactive modification of an address;
boolean zch # if zipcode could not have changed, avoids a typeout;
string ent;
integer b,j,jmax,p,k;
if (p←find("of entry to be modified"))=0 then return;
display(p);
zch←false;
while true do
	begin jmax←nl+1; if jmax>5 then jmax←5;
	print("Type number of a line to be changed (1 to ",jmax,"),
	or <cr> if modifications are complete: "); ttin;
	if typein = icr then done;
	j←typein-"0";
	if j≤0 or j>jmax then print("Invalid line number.",crlf)
	else	begin label prompt;
prompt:		print("New line ",j,": "); ttin;
		if typein=icr then
			begin nl←j-1; zch←true;
			continue;
			end
		else if length(typein)>35 then
			begin shorten(length(typein)-35);
			go to prompt;
			end;
		lne[j]←typein&lf;
		if j≥nl then zch←true;
		if j>nl then nl←nl+1;
		end;
	end;
if not zipcheck(zch) then return;
afchanged←true;
ent←lop(typein)&zip&lne[0][7 to 18];
for j←2 step 1 until nl do ent←ent&lne[j];
k←key[p];b←balance[p];
if not equ(zip[1 to 3], lne[0][2 to 4]) then
	begin delete(key[p]);
	gethash;
	print("Hashcode changed from #",cvstr(k)," to #",hash,".",crlf);
	insert(lne[1],ent,hash,b) # it goes into location p again but relinked;
	end else
	begin comment hashcode did not change;
	nmline[p]←lne[1]; lines[p]←ent;
	end;
print("OK, the modification has been made.",crlf);
end;

procedure del;
begin comment interactive deletion of a table entry;
integer j,p;
if(p←find("of entry to be deleted"))=0 then return;
display(p);
j←ynresp("Do you really want to delete this?");
if j≠1 then return else
	begin delete(key[p]);
	afchanged←true;
	print("OK, I did it.",crlf);
	end;
end;

procedure update # main control routine for update loop;
begin comment when debugging, call bail here;
while true do
	case resp("UPDATE: INS, DEL, MOD, or LOOK? ",updhelp,updopts) of
		begin done;ins;del;mfy;look;
		end;
end;
comment The procedure which records orders received;

procedure orders;
begin comment the files ORDERS.XXX, where XXX is a month,
	consist of a number of lines of the form 
		#HHHHH,SSSSS:DDDDtabDATEcrlf
	where HHHHH is the hashcode (ignored in the processing),
	SSSSS is the serial number, DDDD is a variable-length list
	of report-order digits 0,...,9,A,B,..., and DATE is the
	date of recording this order in the file;
integer flag,j,p;
j←resp("For which month? ",ordhelp,months);
if j=0 then return else mon←months[j];
close(ichan); lookup(ichan,"ORDERS."&mon,flag);
if enterfail(ochan,"ORDERS."&mon) then return;
if flag then
	begin print("No orders on file for that month, I will create a new file.",
	crlf);
	end
else	begin print("I will append to existing orders recorded on file ORDERS.",
	mon,".",crlf);
	stt←input(ichan,bff);
	if equ(stt[1 to 10],"COMMENT ⊗ ") then
		begin while brchar≠iff do stt←input(ichan,bff) # skip directory page;
		stt←input(ichan,bff);
		end;
	do	begin out(ochan,stt); stt←input(ichan,bff)
		end until stt=0;
	end;
j←0;
while true do
	begin if(p←find("of person ordering"))=0 then done;
	if resp("Reports ordered: ",ordhelp,nullopt)=0 then continue;
	j←j+1;
	setformat(7,2);
	out(ochan,"#"&cvstr(key[p])&","&cvs(p)&":"&typein[1 to ∞-1]
		&tab&date&crlf);
	setformat(0,2);
	end;
close(ochan);
print(j," new orders written onto ORDERS.",mon,".",crlf);
end;
comment Procedures for making labels: lab,emitlab,endlab;

integer ltype # 0 for AVERY labels, 1 for CHESHIRE;
integer lct # mod 3 counter for CHESHIRE label output;
string array blne[1:5] # CHESHIRE label buffer;

string procedure lab(integer p,w; boolean lvunpacked,free);
begin comment makes a 5-line label, w characters wide, for addressee at
	serial number p, either leaving the result in lne[1] thru lne[5]
	(if lvunpacked is true) or delivering it as a string.
	If free=true, the word "(FREE)" is inserted on the second line
	when appropriate;
unpack(p);
for i←1 step 1 until nl do
	begin stt←lne[i][1 to ∞-2]&blanks;
	lne[i]←stt[1 to w-6]&
	(if i=1 then "#"&cvstr(key[p])
	else if free and i=2 and lne[0]≠"C" then "(FREE)"
	else stt[w-5 to w])&crlf;
	end;
for i←nl+1 step 1 until 5 do lne[i]←
	if lvunpacked then blanks[1 to w]&crlf else crlf;
if lvunpacked then return("")
else return(lne[1]&lne[2]&lne[3]&lne[4]&lne[5]&crlf);
comment note that a sixth blank line was returned;
end;

procedure emitlab(integer p,free) # outputs one label;
case ltype of
	begin out(lchan,lab(p,34,false,free)) # AVERY label;
		begin lab(p,34,true,free) # CHESHIRE label;
		for i←1 step 1 until 5 do
		case lct of
			begin blne[i]←lne[i][1 to 34]&" " # lct=0;
			blne[i]←blne[i]&lne[i][1 to 34]&" " # lct=1;
			out(lchan,blne[i]&lne[i]) # lct=2;
			end;
		lct←(lct+1)mod 3; if lct=0 then out(lchan,crlf);
		end;
	end;

procedure endlab;
begin comment outputs the last labels, if any;
if ltype = 1 and lct≠0 then out(lchan,blne[1]&crlf&blne[2]&crlf&blne[3]&crlf
			&blne[4]&crlf&blne[5]&crlf);
close(lchan);
print("The mailing labels have been written onto file LABELS.TMP. 
To print them, see instructions in the user manual; be sure to delete
this file afterwards.",crlf);
end;
comment The MAIL procedure and its subprocedures abst,invo,inv,status,scanorders;

procedure mail;
begin comment takes care of abstract and invoice mailings;
comment The following arrays are allocated only within MAIL;
integer array send,sorry[0:asize] # record of orders that can and can't be filled;
integer array msk[0:42] # the bit corresponding to a report, if that report
	appears on the current month's list (send and sorry use these bit codes);
string array starname,reptname[0:42] # identifies a report;
integer array stock,filled,unf[0:42] # on hand, requests filled, requests unfilled;
integer array reptcost[0:42] # price of report in pennies;
integer imax # maximum report number;

recursive procedure abst(integer p) # emits mailing labels in symmetric
	order (i.e., in order by hashcode) for tree rooted at p;
if p≠0 then
	begin abst(llink[p]);
	j←lines[p];
	if j="C" or j="F" then emitlab(p,true);
	abst(rlink[p]);
	end;

integer procedure status;
begin comment prints a status report for the user, and returns 0,1,2 according as
the verdict is to start over, go ahead with shifting, go ahead without shifting;
print("I have read through all the orders, and here is how things stand:
(hardcopy)	To be	Unfillable	(microfiche)	To be	Unfillable
Cost  On hand	sent	requests	      On hand	sent	requests
"); for i←1 step 2 until imax do
	begin print(starname[i]);
	j←cvc(i)-"1"; print("$",cvf(reptcost[j]/100),tab,stock[j],tab,
	filled[j],tab,unf[j],tab);
	j←cvc(i+1)-"1"; print(tab,tab,stock[j],tab,filled[j],tab,unf[j],crlf);
	end;
print("Please check this carefully. If there has been some error,
type <cr> to exit; but if it's all right to go ahead and print the invoices,
type Y<cr> and I will prepare them: "); ttin;
if typein = "Y" then
begin j←resp("OK, I will begin to work on the invoices.
Do you want the activity codes to be shifted? (Y or N) ",acthelp,yesnoopts);
return(j);
end else
	begin print("OK, I will not print those invoices, please try again.",
	crlf); return(0);
	end;
end;

procedure scanorders;
begin comment read through all orders;
key[0]←0;
stt←input(ichan,bfflf);
if equ(stt[1 to 10],"COMMENT ⊗ ") then
	begin while brchar≠iff do stt←input(ichan,bff) # skip directory page;
	stt←input(ichan,bfflf);
	end;
for i←1 step 1 until asize do send[i]←send[i]←0;
while true do
	begin label nextline; integer sendp,sorryp;
	if eof then done;
	if stt="#" then
		begin p←cvd(stt[8 to 14]);
		if p>asize or key[p]=0 then
			begin print("I ignored the order ",stt,
			"since that serial number is no longer in the file.",crlf);
			go to nextline;
			end;
		st←stt[16 to ∞];
		sendp←send[p];sorryp←sorry[p];
		while st≥"1" do
			begin j←lop(st)-"1";
			if j>42 or msk[j]=0 then
				begin print("I ignored the invalid report code "&
				(j+"1")," which appears in the following order:",
				crlf,stt);
				end
			else if((sendp lor sorryp)land msk[j])=0 then
				begin if stock[j]>filled[j] then
					begin filled[j]←filled[j]+1;
					sendp←sendp lor msk[j];
					end
				else	begin unf[j]←unf[j]+1;
					sorryp←sorryp lor msk[j];
					end;
				end;
			end;
		send[p]←sendp;sorry[p]←sorryp;
		end;
nextline:stt←input(ichan,bfflf);
	end;
end;

procedure inv(integer p;boolean shift);
begin comment processes the addressee with serial number p;
integer reps; reps←0;
if lines[p]≠"C" and lines[p]≠"F" and shift then emitlab(p,false)
else if send[p]≠0 or sorry[p]≠0 or
(shift and balance[p]>0 and equ(lines[p][17 to 18],"00"))
then	begin string addrlab,sends,sorrys; integer t,j,tbal;
	sends←sorrys←""; tbal←reps←0;
	if send[p]≠0 then
		begin t←send[p];
		for j←0 step 1 until 42 do if msk[j] land t ≠ 0 then
			begin reps←reps+1;
			sends←sends&reptname[j];
			if lines[p]≠"C" or reptcost[j]=0 then
			sends←sends&crlf
			else	begin tbal←tbal+reptcost[j];
				sends←sends&"    $"&cvf(reptcost[j]/100)&crlf;
				end;
			if(t←t xor msk[j])=0 then done;
			end;
		end;
	if sorry[p]≠0 then
		begin t←sorry[p];
		for j←0 step 1 until 42 do if msk[j] land t ≠ 0 then
			begin reps←reps+1;
			sorrys←sorrys&reptname[j]&crlf;
			if(t←t xor msk[j])=0 then done;
			end;
		end;
	addrlab←lab(p,50,false,false);
	invout(sends,sorrys,nmline[p],addrlab,balance[p],tbal,
		key[p]≥cvasc("90000") and key[p]<cvasc("96700"));
	emitlab(p,false);
	balance[p]←balance[p]+tbal;
	chgd←chgd+tbal;
	end;
st←lines[p];
if shift then lines[p]←st[1 to 6]&st[8 to 18]&cvc(reps)&st[19 to ∞]
else if reps > 0 then
	begin t←st[18 to 18]-"0";
	if t>9 then t←t-7;
	lines[p]←st[1 to 17]&cvc(t+reps)&st[19 to ∞];
	end;
end;

recursive procedure invo(integer p;boolean shift);
begin comment calls inv for all addresses in p's subtree, symmetric order;
if p≠0 then
	begin invo(llink[p],shift);inv(p,shift);invo(rlink[p],shift);
	end;
end;

comment The MAIL procedure really starts here;
if mailed then
	begin print("Sorry, but you can't use MAIL again at this session;
	you have to spool the output from this session first.",crlf);
	return;
	end;
if enterfail(lchan,"LABELS.TMP") then return;
if (ltype←resp("MAIL subsystem: AVERY or CHESHIRE labels? ",mailhelp,labelopts)-1)
	< 0 then return;
case resp("MAIL subsystem: Sending abstracts or reports? ",mailhelp,mailopts) of
	begin return;
		begin print("OK, I'm making the labels for you...",crlf);
		abst(troot);
		end;
		begin if textinfail then return;
		j←resp("For which month? ",mailhelp,months);
		if j=0 then return else mon←months[j];
		if lookupfail(ichan,"ORDERS."&mon) then return;
		if enterfail(ochan,"INVOIC.TMP") then return;
		comment now get report data;
		print("I need to know some things from that abstract list.",crlf);
		for j←0 step 1 until 42 do msk[j]←0;
		imax←0;
		for i←1 step 2 until 35 do
			begin label restart;
restart:		if resp("Please enter STAN- or AIM- number of reports "&
			cvc(i)&" and "&cvc(i+1)&", followed by *AUTHOR,TITLE"&crlf&
			" (or <cr> if done, QUIT<cr> to abort):"&crlf,
			rhelp,nullopt) = 0 then done;
			if equ(typein[1 to 4],"QUIT") then return;
			j←cvc(i)-"1"; k←cvc(i+1)-"1";
			starname[i]←typein&lf;
			str←starname[i];st←scan(str,bast,brchar);
			reptname[j]←st&"(hardcopy) ";
			reptname[k]←st&"(microfiche) ";
			if(reptcost[j]←cresp("What is the cost of hardcopy? "&
			"(If unavailable, say anything.) "))<0 then go to restart;
			reptcost[k]←0;
			for p←j,k do
				begin print("How many copies of ",reptname[p],
				crlf,"are available for distribution? "); ttin;
				if typein=icr then go to restart;
				stock[p]←inscan;unf[p]←filled[p]←0;
				end;
			reptname[j]←reptname[j]&str[1 to ∞-2];
			reptname[k]←reptname[k]&str[1 to ∞-2];
			if ynresp("Thanks. Can I assume that the information "&
			"you just gave for this report "&crlf&
			"is correct and complete?") ≠ 1 then
				begin print("Then let's try again.",crlf);
				go to restart;
				end
			else	begin msk[j]←1 lsh(i-1); msk[k]←1 lsh i;
				imax←i;
				end;
			end;
		print("OK, now I'm looking at the orders...",crlf);
		scanorders;
		case status of
			begin return;invo(troot,true);invo(troot,false);
			end;
		close(ochan); afchanged←true;
		print("The invoices, bills of lading, and dunning letters have ",
		"been written",crlf,"onto file INVOIC.TMP. To print them, do",
		crlf,tab,tab,"XS INVOIC.TMP/NOHEAD",crlf,
		"and after successful completion of that do",crlf,tab,tab,
		"DEL INVOIC.TMP",crlf,tab,tab,"DEL ORDERS.",mon,crlf,
		"since these files ought to be deleted as soon as the invoices ",
		"have been",crlf,"correctly prepared.",crlf);
		end;
	end;
endlab;
mailed←true;
end;
comment The `receive' procedure, which handles virtual money;

procedure receive;
begin comment interactive processing of receipts;
while true do
	begin label prompt; integer amt;
	p←find("of account to credit (or 99999)");
	afchanged←true;
	if p=0 then done;
prompt:	print("Amount rec'd (or amount + or -, if accounting adjustment)? $");ttin;
	amt←inscan;
	if scale≠2 then
		begin print("Type amount followed by <cr>, e.g., 5.20<cr>,",crlf,
		"if $5.20 has been received in payment for this account.",crlf,
		"Type amount followed by -<cr> if the account balance is to",crlf,
		"decrease by this amount but no payment has been received.",crlf,
		"Type amount followed by +<cr> if the account balance is to",crlf,
		"increase by this amount. Just type <cr> to leave the account",crlf,
		"unchanged. People not on the mailing list have hash code #99999.",
		crlf); go to prompt;
		end;
	if brchar="-" then
		begin fixd←fixd+amt; balance[p]←balance[p]-amt;
		end
	else if brchar="+" then
		begin fixd←fixd-amt; balance[p]←balance[p]+amt;
		end
	else	begin label notax; if brchar≠"." then
			begin print("Incorrect form, try again.",crlf);
			go to prompt;
			end;
		if key[p]=cvasc("99999") then
			begin if ynresp("California resident?")≠1 then go to notax;
			end
		else if key[p]<cvasc("90000") or key[p]≥cvasc("96700") then
			go to notax;
		comment We must pay tax on California residents, the tax was
			included in the purchase price;
		calrecd←calrecd+amt;
notax:		balance[p]←balance[p]-amt; recd←recd+amt;
		end;
	end;
end;
comment The `send' procedure, for isolated orders;

procedure send;
begin string array oldrep,title[0:bsize];
integer array onhandh,onhandm,cost[0:bsize];
comment if the file ONHAND.DSK contains a line like this:
*CS249|STAN-CS-74-249*KNUTH,HOW NOT TO RUN A COMMITTEE|22|0|$3.50
then the internal representation has oldrep[i]="CS249", title[i]=
"STAN...TEE", onhandh[i]=22 (hardcopy on hand), onhandm[i]=0,
cost[i]=350. If the line on the file is "*AIM123|SAME" then
oldrep[i]="AIM123", title[i]="", and it means the same as report i-1;
integer imax,amt; boolean fiche;
integer array bufh,bufm[0:30] # places to update onhandh,onhandm;
integer ph,pm # stack pointers for bufh, bufm;
if sended then
	begin print("Sorry, but you can't use SEND again at this session;
	you have to spool the output from this session first.",crlf);
	return;
	end;
if textinfail then return;
if lookupfail(ichan,"ONHAND.DSK") then return;
if enterfail(ochan,"BILLS.TMP") then return;
imax←-1;
for i←0 step 1 until bsize-1 do
	begin do st←input(ichan,bfflf) until lop(st)="*" or eof;
	if eof then done;
	oldrep[i]←scan(st,babs,brchar);
	if equ(st[1 to 4],"SAME") then title[i]←"" else
		begin title[i]←scan(st,babs,brchar);
		typein←scan(st,babs,brchar)&icr; onhandh[i]←inscan;
		typein←scan(st,babs,brchar)&icr; onhandm[i]←inscan;
		typein←st; cost[i]←inscan;
		end;
	imax←i;
	end;
print("I have found ",imax+1," records about old reports in file ONHAND.DSK.",crlf);
close(ichan);

while true do
	begin string name,addr,sends,sorrys,thenext;
	integer tbal,reps; boolean free;
	if(p←find("(or 99999) for person requesting old reports"))=0 then done;
	afchanged←true;
	ph←pm←0;
	if key[p]=cvasc("99999") then
		begin print("Type the name and address of customer, ",
		"followed by a blank line:",crlf); ttin;
		if typein=icr then continue else name←typein&lf;
		ttin; if typein=icr then continue else addr←name&typein&lf;
		while true do
			begin ttin; if typein=icr then done else addr←addr&typein&lf;
			end;
		free←
		  ynresp("Should this customer get the reports free of charge?")=1;
		end
	else free←lines[p]≠"C";
	thenext←sends←sorrys←""; tbal←reps←0;
	while true do
		begin label found,notfound;
		if resp("Type short name of "&thenext&"report requested: ",
		sendhelp,nullopt) = 0 then done;
		reps←reps+1;
		st←typein[1 to ∞-1]; if st[∞ for 1] = "F" then
			begin st←st[1 to ∞-1]; fiche←true;
			end else fiche←false;
		for i←imax step -1 until 0 do if equ(oldrep[i],st) then
			begin k←i; while title[k]=0 do k←k-1;
			go to found;
			end;
notfound:	print("I couldn't find that one in the file.",crlf);
		if resp("Enter its specs in the form STAN- or AIM-number "&
		"followed by *AUTHOR,TITLE:"&crlf,rhelp,nullopt)=0 then done;
		k←bsize; title[k]←typein[1 to ∞-1];
		if imax=bsize-1 then j←2 else
		j←ynresp("Do you want to enter it into the file?");
		case j of
			begin done;
				begin comment new entry in the file;
				k←imax+1; oldrep[k]←st;
				title[k]←title[bsize];
				cost[k]←cresp("What is the price of hardcopy? ");
				if cost[k]<0 then done;
				print("How many hard copies are on hand? "); ttin;
				onhandh[k]←inscan;
				print("How many microfiche copies are on hand? ");
				ttin; onhandm[k]←inscan;
				imax←k;
				end;
				begin comment no new entry;
				j←ynresp("Do you have a copy on hand?");
				case j of
					begin done;
					onhandh[k]←onhandm[k]←1;
					onhandh[k]←onhandm[k]←0;
					end;
				if(not fiche)and(not free)and(j=1) then
				cost[k]←cresp("What does it cost? ");
				if cost[k]<0 then done;
				end;
			end;
found:		str←title[k]; st←scan(str,bast,brchar);
		if fiche then
			begin amt←0; st←st&"(microfiche) "&str;
			j←onhandm[k]-1;
			if j≥0 and k<bsize then
				begin bufm[pm]←k; pm←pm+1;
				end;
			end else
			begin amt←cost[k]; st←st&"(hardcopy) "&str;
			j←onhandh[k]-1;
			if j≥0 and k<bsize then
				begin bufh[ph]←k; ph←ph+1;
				end;
			end;
		if j<0 then sorrys←sorrys&st&crlf
		else	begin if (not free) and (amt>0) then
				begin tbal←tbal+amt;
				st←st&"  $"&cvf(cost[k]/100);
				end;
			sends←sends&st&crlf;
			end;
		thenext←"the next ";
		end;
	if ynresp("Before I make up the invoice, you'd better doublecheck"&
	" the above."&crlf&
	(if sends≠0 then "We will be sending"&crlf&sends else "")&
	(if sorrys≠0 then "We will say that we are unable to send"&crlf&sorrys
		else "")&
	"Is it all right to make up the invoice?")≠1 then
		begin print("OK, please try again.",crlf);continue;
		end;
	print("OK, I am making an invoice for this customer.",crlf);
	while pm>0 do
		begin pm←pm-1; k←bufm[pm];
		onhandm[k]←onhandm[k]-1;
		end;
	while ph>0 do
		begin ph←ph-1; k←bufh[ph];
		onhandh[k]←onhandh[k]-1;
		end;
	if key[p]=cvasc("99999") then
		invout(sends,sorrys,name,addr,0,tbal,false)
	else	begin addr←lab(p,50,false,false);
		invout(sends,sorrys,nmline[p],addr,balance[p],tbal,
			key[p]≥cvasc("90000")and key[p]<cvasc("96700"));
		t←lines[p][18 to 18]-"0"; if t>9 then t←t-7;
		lines[p]←lines[p][1 to 17]&cvc(reps+t)&lines[p][19 to ∞];
		end;
	balance[p]←balance[p]+tbal;chgd←chgd+tbal;
	sended←true;
	end;
if sended then print("I wrote the invoices onto file BILLS.TMP. 
To print them, do
		XS BILLS.TMP/NOHEAD
and after successful completion don't forget to DEL BILLS.TMP.",crlf);
comment now rewrite the ONHAND.DSK file;
if enterfail(ochan,"ONHAND.DSK") then return;
for i←0 step 1 until imax do
	begin out(ochan,"*"&oldrep[i]&"|");
	if title[i]=0 then out(ochan,"SAME"&crlf)
	else out(ochan,title[i]&"|"&cvs(onhandh[i])&"|"&
		cvs(onhandm[i])&"|$"&cvf(cost[i]/100)&crlf);
	if i mod 60 = 59 then out(ochan,ff);
	end;
close(ochan);
end;
comment The president (chief executive);

procedure the_president;
begin comment The main control routine for csreport system functions;
if lookupfail(ichan,"ADDFIL.DSK") then return;
addfilin;
recd←fixd←chgd←calrecd←0;
while true do
case resp(crlf&"  CSREPORT system:  What can I do for you? ",cshelp,csopts) of
		begin done;
		update;
		orders;
		receive;
		mail;
		send;
		end;
if afchanged and ynresp("May I record all of today's transactions permanently"&
	" on file ADDFIL.DSK?")=1 then
	begin if enterfail(ochan,"ADDFIL.DSK") then return;
	addfilout;
	end
else print("No changes made to ADDFIL.DSK this time.",crlf);
if recd+calrecd+abs(fixd)+chgd>0 then
print(crlf,"SUMMARY of today's financial transactions:
$",cvf(recd/100)," received in payments,
$",cvf(calrecd/100)," of which was from residents of California.
$",cvf(fixd/100)," was subtracted from accounts due to adjustments or
	deletions from the mailing list.
$",cvf(chgd/100)," new charges were sent out on invoices.",crlf);
end;
comment The program starts here (sets string constants, including HELPs);

tab←'11;
lf←'12;
ff←'14;

setformat(0,2) # format should always be returned to this if changed;

t←call(0,"DATE");
d←t mod 31 + 1;
m←(t←t div 31) mod 12 +1;
date←cvs(d)&" "&months[m]&" "&cvs(1964+ t div 12);

blanks←"                              ";
blanks←blanks&blanks;

cshelp←"Hello, this is your friendly CSREPORT system.
There are five kinds of things I am programmed to do for you:
	UPDATE	Look at and perhaps change the mailing list.
	ORDER	File away any orders that have been received
		for a given month's list.
	RECEIVE	Record payments received, or adjust accounts.
	MAIL	Prepare mailing labels and/or invoices and
		bills of lading for everyone that has ordered
		reports from a given month's list.
	SEND	Prepare invoices for isolated back-order requests,
		including orders from people not on the mailing list.
When I ask, `What can I do for you?', just type the first three letters
of one of these functions and hit carriage RETURN <cr>. (You can also
type more than three letters if you want to.) The user's manual, which
contains more information, is file REPORT.TXT[DOC,CSR].";

findhelp1←"I am going to try to identify an addressee for you. Type the
five-character hash code if you know it, or type 99999 if the
addressee is not on our mailing list and not being inserted into it.
If you don't know the hash code, type XXXXX and I will try a name search
of the whole file. If you type just <cr> now, I will go on to something
else. Since hash codes sometimes change, you should doublecheck the
addressee name I find in case it is the wrong person.";

findhelp2←"I am trying to identify an addressee for you. Type the name
or any part of the name, and I will show you all name lines in the file 
which contain that sequence of characters (including blank spaces in
the middle of the sequence, if you use them). Note that I will search
only the first line of each address on the mailing list.";

codehelp←"Type <cr> to reject this entry and flush it; or type C<cr> for
normal entry, F<cr> for the free list, N<cr> for the ONR list, M<cr> for
the ARPA list, A<cr> for the `automatic' list.";

updhelp←"The UPDATE routine should be used to make all changes to the
address file, since editing with E is risky. To insert a new entry,
type INS and follow instructions. To modify an existing entry, type
MOD and see what happens.  To delete an entry, type DEL (but don't delete
anybody who has orders outstanding on some ORDERS file -- it's best to
delete only after MAILing all orders).  To simply look at an entry,
type LOOK.  Type only <cr> when you want to quit updating.";

ordhelp←"The ORDERS subsystem is used to record orders received from a
given month's mailing list. You identify a person by his hashcode,
the system tells you his name, and when everything checks you
say which reports he has ordered. For example, if he wants reports
1,9,A, and G, you can type 19AG or 1AG9, etc.  This information
is appended to the file ORDERS.XXX where XXX is JAN,FEB, ..., or DEC.";

mailhelp←"The MAIL subsystem is used to prepare mailing labels and/or
invoices for monthly report distribution.  Two kinds of mailing labels
are presently provided for: AVERY (34 characters wide, one printed
at a time) and CHESHIRE (34 characters wide and three printed at once).
When mailing an abstract list, type ABS<cr> and I will prepare the file
LABELS.TMP containing mailing labels for everyone on the mailing list
except codes N, M, or A.  When mailing invoices and reports, type
REP<cr> and give the necessary information about the relevant month's
reports.  The ORDERS.XXX file for that month will be used to specify
all orders, and the activity records for all customers are shifted
left one position unless you request otherwise.";

acthelp←"Each addressee has activity codes representing the number of orders
he made during the last 12 mailing periods. If you type Y<cr>, the
present mailing is considered a new mailing period.  If you type
N<cr> or <cr>, the present mailing is considered to be combined with
the previous mailing period.";

sendhelp←"Give the short name of a report requested, e.g. CS287 or AIM239,
followed by F if it is microfiche, e.g. CS287F.  But if no more 
reports are requested by this customer, just type <cr>.";

yesnohelp←"Answer YES,SIR<cr> or NO,SIR<cr> or some abbreviation.";

rhelp←"At this point I need to know the names and numbers of the reports,
in order to identify them meaningfully on the invoices to
be written. Here are two examples of the form I want you to type:
STAN-CS-76-562*KNUTH,TRABB PARDO,EARLY DEVEL OF PROG LANGUAGES
AIM-282*TAYLOR,SYNTHESIS OF MANIPULATOR CONTROL PROGRAMS(THESIS)
Note that there should be an asterisk (and no space) between the report
number and the author name(s). The title has to be abbreviated so that
everything fits on one line, even when I substitute the word `(microfiche) '
for the asterisk. If the report is a thesis, follow the title by `(THESIS)'.";
comment Set breaks, open channels, call main procedure, end gracefully;

setbreak(btt,lf,null,"ISK") # for ttin, translates lower case to upper;
setbreak(bfflf,ff&lf,null,"IA") # for scanning lines of character files;
setbreak(bff,ff,null,"IA") # for scanning pages quickly but carefully;
setbreak(blf,lf,null,"IA") # for scanning lines within a page;
setbreak(babs,"|",null,"IS") # for separating substrings delimited by |;
setbreak(bast,"*",null,"IS") # for separating substrings delimited by *;

eof←0;
open(ichan←getchan,"DSK",0,19,0,450,brchar,eof) # channel for character input;
open(ochan←getchan,"DSK",0,0,19,0,0,eof) # channel for character output;
open(lchan←getchan,"DSK",0,0,19,0,0,eof) # channel for mailing label output;

setprint("DIALOG.TMP","B");

mailed←sended←afchanged←false;

the_president;

print(crlf,"See you later. Be sure to xspool a copy of DIALOG.TMP,
	which records what happened today.");

setprint(null,"N"); comment closes the dialog file;

close(ichan); close(ochan); close(lchan) # just in case I forgot;
end;